home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / turbovis / tvtoys04.zip / DBLSTR.PAS < prev    next >
Pascal/Delphi Source File  |  1993-12-07  |  4KB  |  129 lines
  1. (***************************************************************************
  2.   DoubleStr unit
  3.   Dual string management and string collection
  4.   PJB November 3, 1993, Internet mail to d91-pbr@nada.kth.se
  5.   Copyright 1993, All Rights Reserved
  6.   Free source, use at your own risk.
  7.   If modified, please state so if you pass this around.
  8.  
  9.   This is the easy way out if you want to connect items in a list box
  10.   to other items. You should really override the ListBox' GetText
  11.   function. Double strings work with any type of list box, though!
  12.  
  13.   Borland botched by not using (or creating) a virtual method for
  14.   collection data access, probably for speed reasons.
  15.  
  16. ***************************************************************************)
  17. unit DblStr;
  18. {$R-,X+}
  19.  
  20. interface
  21.  
  22.   uses
  23.     Objects, Strings;
  24.  
  25.   type
  26.     PCaseInsensitiveStringCollection = ^TCaseInsensitiveStringCollection;
  27.     TCaseInsensitiveStringCollection =
  28.       object (TStringCollection)
  29.         function Compare(Key1, Key2:Pointer):Integer; virtual;
  30.       end;
  31.  
  32.     PDblStringCollection = ^TDblStringCollection;
  33.     TDblStringCollection =
  34.       object (TCaseInsensitiveStringCollection)
  35.         function  At2nd(Index:Integer) : Pointer;
  36.         procedure FreeItem(Item:Pointer); virtual;
  37.       end;
  38.  
  39.   function  NewDoubleStr(const s1,s2:String):PString;
  40.   procedure DisposeDoubleStr(P:PString);
  41.  
  42.  
  43. (***************************************************************************
  44. ***************************************************************************)
  45. implementation
  46.  
  47.  
  48.   (*******************************************************************
  49.     Create a "double" string, two strings in one block
  50.   *******************************************************************)
  51.   function NewDoubleStr;
  52.     var
  53.       p : PChar;
  54.   begin
  55.     GetMem(p, Length(s1)+Length(s2)+2);
  56.     PString(p)^:=s1;
  57.     PString(p+Length(s1)+1)^:=s2;
  58.     NewDoubleStr:=PString(p);
  59.   end;
  60.  
  61.  
  62.   (*******************************************************************
  63.     Dispose of a double string allocated by NewDoubleStr
  64.   *******************************************************************)
  65.   procedure DisposeDoubleStr;
  66.   begin
  67.     FreeMem(P, Ord(P^[0]) + Ord(P^[Ord(P^[0])+1]));
  68.   end;
  69.  
  70.  
  71. (***************************************************************************
  72. ***************************************************************************)
  73.  
  74.   (*******************************************************************
  75.     FAST Case insensitive comparison
  76.   *******************************************************************)
  77.   function TCaseInsensitiveStringCollection.Compare;
  78.     var
  79.       l, l1, l2 : Byte;
  80.       c : Integer;
  81.   begin
  82.     l1:=Byte(Key1^);
  83.     l2:=Byte(Key2^);
  84.  
  85.     l:=l2;
  86.     if l1<l2 then
  87.       l:=l1;
  88.  
  89.     c:=StrLIComp(PChar(Key1)+1, PChar(Key2)+1, l);
  90.     if (c=0) and (l1<>l2) then
  91.       if l1<l2 then
  92.         Compare:=-1
  93.       else
  94.         Compare:=1
  95.     else
  96.       Compare:=c;
  97.   end;
  98.  
  99.  
  100. (***************************************************************************
  101. ***************************************************************************)
  102.  
  103.   (*******************************************************************
  104.     Access the "hidden" string
  105.   *******************************************************************)
  106.   function TDblStringCollection.At2nd;
  107.     var
  108.       p : PChar;
  109.   begin
  110.     p:=At(Index);
  111.     inc(p, ord(p^)+1);
  112.     At2nd:=p;
  113.   end;
  114.  
  115.  
  116.   (*******************************************************************
  117.     Free double string
  118.   *******************************************************************)
  119.   procedure TDblStringCollection.FreeItem;
  120.   begin
  121.     DisposeDoubleStr(Item);
  122.   end;
  123.  
  124.  
  125.     (*******************************************************************
  126.     *******************************************************************)
  127.  
  128. end.
  129.